home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / LISP / XLISP / XLISP21S / sources / c / xlisp < prev    next >
Text File  |  1992-04-25  |  6KB  |  221 lines
  1. /* xlisp.c - a small implementation of lisp with object-oriented programming */
  2. /*      Copyright (c) 1987, by David Michael Betz
  3.         All Rights Reserved
  4.         Permission is granted for unrestricted non-commercial use       */
  5.  
  6. /* For full credits see file xlisp.h */
  7.  
  8. #include "xlisp.h"
  9.  
  10. /* define the banner line string */
  11. #define BANNER  "XLISP-PLUS version 2.1d\n\
  12. Portions Copyright (c) 1988, by David Betz.\n\
  13. Modified by Thomas Almy and others."
  14.  
  15.  
  16. /* global variables */
  17. #ifdef SAVERESTORE
  18. jmp_buf top_level;
  19. #endif
  20.  
  21. /* external variables */
  22. extern LVAL s_stdin,s_stdout,s_evalhook,s_applyhook;
  23. extern LVAL s_1plus,s_2plus,s_3plus,s_1star,s_2star,s_3star,s_minus;
  24. extern int xltrcindent;
  25. extern int xldebug;
  26. extern LVAL true;
  27. extern FILEP tfp;
  28.  
  29. /* usage - print command line usage, then quit TAA addition */
  30. #ifdef ANSI
  31. VOID usage(void) {
  32. #else
  33. VOID usage() {
  34. #endif
  35. #ifdef SAVERESTORE
  36.     fprintf(stderr,"Valid Arguments:\n\t-?\tThis help\n\
  37. \t-tfname\tOpen transcript (dribble) file fname\n\
  38. \t-v\tLoad verbosely\n\
  39. \t-w\tDon't restore from xlisp.wks\n\
  40. \t-wfname\tRestore from fname\n\
  41. \tfname\tLoad file fname\n");
  42. #else
  43.     fprintf(stderr,"Valid Arguments:\n\t-?\tThis help\n\
  44. \t-tfname\tOpen transcript (dribble) file fname\n\
  45. \t-v\tLoad verbosely\n\
  46. \tfname\tLoad file fname\n");
  47. #endif
  48.     exit(1);
  49. }
  50.  
  51. /* main - the main routine */
  52. #ifdef ANSI
  53. VOID CDECL main(int argc, char *argv[])
  54. #else
  55. VOID main(argc,argv)
  56.   int argc; char *argv[];
  57. #endif
  58. {
  59.     char *transcript;
  60.     CONTEXT cntxt;
  61.     int verbose,i;
  62.     LVAL expr;
  63. #ifdef SAVERESTORE
  64.     char *resfile = "xlisp.wks";    /* TAA mod -- command line restore file */
  65. #endif
  66.  
  67.     /* setup default argument values */
  68.     transcript = NULL;
  69.     verbose = FALSE;
  70.  
  71.     /* parse the argument list switches */
  72. #ifndef LSC
  73.     for (i = 1; i < argc; ++i)
  74.         if (argv[i][0] == '-')
  75.             switch(tolower(argv[i][1])) {
  76.             case '?':   /* TAA MOD: added help */
  77.                 usage();
  78.             case 't':
  79.                 transcript = &argv[i][2];
  80.                 break;
  81.             case 'v':
  82.                 verbose = TRUE;
  83.                 break;
  84. #ifdef SAVERESTORE
  85.             case 'w':
  86.                 resfile = &argv[i][2];
  87.                 break;
  88. #endif
  89.             default: /* Added to print bad switch message */
  90.                 fprintf(stderr,"Bad switch: %s\n",argv[i]);
  91.                 usage();
  92.             }
  93. #endif
  94.  
  95.     /* initialize and print the banner line */
  96.     osinit(BANNER);
  97.  
  98.     /* setup initialization error handler */
  99.     xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,(LVAL)1);
  100.     if (setjmp(cntxt.c_jmpbuf))
  101.         xlfatal("fatal initialization error");
  102. #ifdef SAVERESTORE
  103.     if (setjmp(top_level))
  104.         xlfatal("RESTORE not allowed during initialization");
  105. #endif
  106.  
  107.     /* initialize xlisp */
  108. #ifdef SAVERESTORE
  109.     i = xlinit(resfile);
  110. #else
  111.     i = xlinit(NULL);
  112. #endif
  113.  
  114.     /* reset the error handler, since we know what "true" is */
  115.     xlend(&cntxt);
  116.     xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,true);
  117.  
  118.     /* open the transcript file */
  119.     if (transcript!=NULL && (tfp = OSAOPEN(transcript,CREATE_WR)) == CLOSED) {
  120.         /* TAA Mod -- quote name so "-t foo" will indicate no file name */
  121.         sprintf(buf,"error: can't open transcript file: \"%s\"",transcript);
  122.         stdputstr(buf);
  123.     }
  124.  
  125.     /* load "init.lsp" */
  126.     if (i && (setjmp(cntxt.c_jmpbuf) == 0))
  127.         xlload("init.lsp",TRUE,FALSE);
  128.  
  129.     /* load any files mentioned on the command line */
  130.     if (setjmp(cntxt.c_jmpbuf) == 0)
  131.         for (i = 1; i < argc; i++)
  132.             if (argv[i][0] != '-' && !xlload(argv[i],TRUE,verbose))
  133.                 xlerror("can't load file",cvstring(argv[i]));
  134.  
  135.     /* target for restore */
  136. #ifdef SAVERESTORE
  137.     if (setjmp(top_level))
  138.         xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,true);
  139. #endif
  140.  
  141.     /* protect some pointers */
  142.     xlsave1(expr);
  143.  
  144.     /* main command processing loop */
  145.     for (;;) {
  146.  
  147.         /* setup the error return */
  148.         if (setjmp(cntxt.c_jmpbuf)) {
  149.             setvalue(s_evalhook,NIL);
  150.             setvalue(s_applyhook,NIL);
  151.             xltrcindent = 0;
  152.             xldebug = 0;
  153.             xlflush();
  154.         }
  155.  
  156.         /* print a prompt */
  157. /*      stdputstr("> "); */
  158.         if (!redirectin) dbgputstr("> ");
  159.  
  160.         /* read an expression */
  161.         if (!xlread(getvalue(s_stdin),&expr))
  162.             break;
  163.  
  164.         /* save the input expression */
  165.         xlrdsave(expr);
  166.  
  167.         /* evaluate the expression */
  168.         expr = xleval(expr);
  169.  
  170.         /* save the result */
  171.         xlevsave(expr);
  172.  
  173.         /* Show result on a new line -- TAA MOD to improve display */
  174.         xlfreshline(getvalue(s_stdout));
  175.  
  176.         /* print it */
  177.         stdprint(expr);
  178.     }
  179.     xlend(&cntxt);
  180.  
  181.     /* clean up */
  182.     wrapup();
  183. }
  184.  
  185. /* xlrdsave - save the last expression returned by the reader */
  186. VOID xlrdsave(expr)
  187.   LVAL expr;
  188. {
  189.     setvalue(s_3plus,getvalue(s_2plus));
  190.     setvalue(s_2plus,getvalue(s_1plus));
  191.     setvalue(s_1plus,getvalue(s_minus));
  192.     setvalue(s_minus,expr);
  193. }
  194.  
  195. /* xlevsave - save the last expression returned by the evaluator */
  196. VOID xlevsave(expr)
  197.   LVAL expr;
  198. {
  199.     setvalue(s_3star,getvalue(s_2star));
  200.     setvalue(s_2star,getvalue(s_1star));
  201.     setvalue(s_1star,expr);
  202. }
  203.  
  204. /* xlfatal - print a fatal error message and exit */
  205. VOID xlfatal(msg)
  206.   char *msg;
  207. {
  208.     xoserror(msg);
  209.     wrapup();
  210. }
  211.  
  212. /* wrapup - clean up and exit to the operating system */
  213. VOID wrapup()
  214. {
  215.     /* $putpatch.c$: "MODULE_XLISP_C_WRAPUP" */
  216.     if (tfp != CLOSED)
  217.         OSCLOSE(tfp);
  218.     osfinish();
  219.     exit(0);
  220. }
  221.